CanvasXpress - Maps

CanvasXpress Visualization of LHA summarized data

Dataset Preparation Notes

• This RMD utilizes the SPEAK survey v1 (summarized) data spreadsheet
  
• Names had to be cleaned to match up with the IDs in the data dictionary

summary.raw <- read.xlsx(xlsxFile       = glue('{params$data_dir}/{params$summary_data_file}'),
                        sheet           = 'Survey Data', 
                        colNames        = FALSE,
                        skipEmptyCols   = FALSE,
                        na.strings      = c("NA", "Suppressed", ""),
                        fillMergedCells = TRUE)

# get good column names we can use
colnames(summary.raw) <- gsub('(%)', '', summary.raw[2, ], fixed = T) %>%
    trimws() %>%
    make.names(unique = T)

# hold onto "row" metadata, this is the communities/names
survey.col.meta <- summary.raw[1, , drop = F] %>% 
    t() %>% as.data.frame() %>%
    rownames_to_column("Name") %>%
    rename(Area = `1`)

# drop the old rows we used to make column names and index the metadata
summary.raw <- summary.raw[-(1:2), ]

# keep the first two columns when we sort out the part of the health data we want (LHA)
keep <- list("Domain" = 1, "Indicator" = 2)

# subset to the LHA columns
summary.lha <- summary.raw[, c(unlist(keep), 
                               which(survey.col.meta$Area == "Sub Regions"))]

# match the LHA IDs for use with map regions
id_lookup <- read.xlsx(xlsxFile        = glue('{params$data_dir}/{params$data_dictionary_file}'),
                       sheet           = 'CHSA_LHA_HSDA_HA_lookup', 
                       colNames        = TRUE,
                       na.strings      = c("NA", "Suppressed", ""),
                       fillMergedCells = TRUE) %>%
    select(LHA, LHA_Name) %>%
    mutate(LHA_Name = make.names(LHA_Name, unique = T))

# raw data
data    <- summary.lha[, -unlist(keep)] %>% t() %>% as.data.frame()
colnames(data) <- make.names(colnames(data), unique = T)

# column/sample (location) annotations
smp.ann <- summary.lha[, names(keep)]
rownames(smp.ann) <- colnames(data)

# row/variable (indication) annotations
var.ann <- data.frame("LHA_Name" = rownames(data), stringsAsFactors = F) %>%
    left_join(id_lookup, by = "LHA_Name")
rownames(var.ann) <- var.ann$LHA_Name
var.ann <- var.ann %>% select(LHA)

#cleanup unused variables
# rm(summary.raw, survey.col.meta, id_lookup, keep, summary.lha)

GEO Data Notes Preparation Notes

• Map boundary data was obtained from: https://www2.gov.bc.ca/gov/content/data/geographic-data-services/land-use/administrative-boundaries/health-boundaries

• Data was downsampled to 1% of original using http://mapshaper.org

# lat/long geojson
boundaries.lha <- read_json(glue('{params$data_dir}/{params$lha_boundaries_file}'))

• Visualization Notes

# chart tooltip events
lha.events <- JS("{
  'mousemove' : function(o, e, t) {
  console.log(t);
}}")

# get the row and column names from the geojson 
# (so the map can match the values up to sections)

ids <- boundaries.lha$features %>%
    lapply(function(x) { list(x[["properties"]]$LOCAL_HLTH_AREA_CODE,
                              x[["properties"]]$OBJECTID) })
ids <- as.data.frame(matrix(unlist(ids), ncol = 2, byrow = T), stringsAsFactors = F) %>%
    rename(LOCAL_HLTH_AREA_CODE = 1, OBJECTID = 2)

rownames(data) <- var.ann$LHA
data <- data[match(ids$LOCAL_HLTH_AREA_CODE, rownames(data)), ]

canvasXpress(
    data       = data,
    # data = FALSE,
    graphType  = "Map",
    title      = "Local Health Authorities (LHA)",
    showLegend = FALSE,
    topoJSON   = boundaries.lha,
    colorBy    = "HLTH_AUTHORITY_NAME",
    events     = NULL #lha.events
)